home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic 4 Database How-To
/
Visual Basic 4 Database - How-to (The Waite Group)(1995).iso
/
attr.fr_
/
attr.fr
Wrap
Text File
|
1995-07-19
|
7KB
|
213 lines
VERSION 4.00
Begin VB.Form frmAttributes
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "Attributes"
ClientHeight = 3090
ClientLeft = 1065
ClientTop = 1455
ClientWidth = 7560
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 3495
Left = 1005
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 3090
ScaleWidth = 7560
Top = 1110
Width = 7680
Begin VB.CommandButton cmdQuit
Caption = "&Quit"
Default = -1 'True
Height = 375
Left = 6360
TabIndex = 3
Top = 2520
Width = 975
End
Begin VB.TextBox txtFuncCount
BackColor = &H00C0C0C0&
Height = 285
Left = 1920
TabIndex = 4
TabStop = 0 'False
Top = 2640
Width = 855
End
Begin VB.ListBox lstFunctions
BackColor = &H00C0C0C0&
Height = 1980
Left = 240
TabIndex = 1
Top = 480
Width = 2535
End
Begin MSGrid.Grid grdGI
Height = 2175
Left = 3000
TabIndex = 2
Top = 240
Width = 4335
_version = 65536
_extentx = 7646
_extenty = 3836
_stockprops = 77
fixedcols = 0
scrollbars = 2
End
Begin VB.Label Label1
BackColor = &H00C0C0C0&
Caption = "Functions Available:"
Height = 255
Left = 240
TabIndex = 0
Top = 240
Width = 2535
End
Begin VB.Label lblFuncCount
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
Caption = "Total Functions:"
Height = 255
Left = 240
TabIndex = 5
Top = 2640
Width = 1575
End
End
Attribute VB_Name = "frmAttributes"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdQuit_Click()
Unload frmAttributes
End Sub
Private Function convCh(inChar As String, num As Variant)
inChar = LTrim$(Left$(inChar, num))
Select Case inChar
Case "Y"
convCh = "Yes"
Case "N"
convCh = "No"
Case Else
convCh = inChar
End Select
End Function
Private Sub Form_Load()
'Resize data here
grdGI.ColWidth(0) = grdGI.Width / 2
grdGI.ColWidth(1) = grdGI.Width / 2
grdGI.ColAlignment(0) = 1
grdGI.ColAlignment(1) = 0
grdGI.Row = 0
grdGI.Col = 0
grdGI.text = "Property"
grdGI.Col = 1
grdGI.text = "Value"
grdGI.FixedAlignment(0) = 2
grdGI.FixedAlignment(1) = 2
grdGI.HighLight = False
'Other setup chores
frmAttributes.Top = 1.5 * frmODBC.Top
frmAttributes.Left = 1.5 * frmODBC.Left
'Load other data source information
ODBCInfo
End Sub
Private Sub ODBCInfo()
Dim fInfoType As Integer
'return values
Dim ri As Integer
Dim rs As String * 255
Dim rgbInfoValue As Long
Dim cbInfoValueMax As Integer
#If Win32 Then
Dim pcbInfoValue As Long
#Else
Dim pcbInfoValue As Integer
#EndIf
Dim result As Integer
Dim temp As String
cbInfoValueMax = 255
result = SQLGetInfo(ghDbc, SQL_ACTIVE_CONNECTIONS, ri, cbInfoValueMax, pcbInfoValue)
If result <> SQL_ERROR Then
grdGI.AddItem "Maximum Connections " & Chr$(9) & IIf(ri = 0, "Unknown", LTrim$(Str$(ri)))
End If
result = SQLGetInfo(ghDbc, SQL_DATA_SOURCE_READ_ONLY, ByVal rs, cbInfoValueMax, pcbInfoValue)
If result <> SQL_ERROR Then
grdGI.AddItem "Data: read only? " & Chr$(9) & convCh(rs, pcbInfoValue)
End If
result = SQLGetInfo(ghDbc, SQL_DBMS_NAME, ByVal rs, cbInfoValueMax, pcbInfoValue)
If result <> SQL_ERROR Then
grdGI.AddItem "DBMS Name " & Chr$(9) & convCh(rs, pcbInfoValue)
End If
result = SQLGetInfo(ghDbc, SQL_DBMS_VER, ByVal rs, cbInfoValueMax, pcbInfoValue)
If result <> SQL_ERROR Then
grdGI.AddItem "DBMS Version " & Chr$(9) & convCh(rs, pcbInfoValue)
End If
result = SQLGetInfo(ghDbc, SQL_DRIVER_NAME, ByVal rs, cbInfoValueMax, pcbInfoValue)
If result <> SQL_ERROR Then
grdGI.AddItem "DBMS Driver Name " & Chr$(9) & convCh(rs, pcbInfoValue)
End If
result = SQLGetInfo(ghDbc, SQL_DRIVER_VER, ByVal rs, cbInfoValueMax, pcbInfoValue)
If result <> SQL_ERROR Then
grdGI.AddItem "DBMS Driver Version " & Chr$(9) & convCh(rs, pcbInfoValue)
End If
result = SQLGetInfo(ghDbc, SQL_DRIVER_ODBC_VER, ByVal rs, cbInfoValueMax, pcbInfoValue)
If result <> SQL_ERROR Then
grdGI.AddItem "Driver ODBC Version " & Chr$(9) & convCh(rs, pcbInfoValue)
End If
result = SQLGetInfo(ghDbc, SQL_ODBC_API_CONFORMANCE, ri, cbInfoValueMax, pcbInfoValue)
If result <> SQL_ERROR Then
Select Case ri
Case SQL_OAC_NONE
temp = "Core Only"
Case SQL_OAC_LEVEL1
temp = "Level 1"
Case SQL_OAC_LEVEL2
temp = "Level 2"
End Select
grdGI.AddItem "ODBC Conformance Level " & Chr$(9) & temp
End If
result = SQLGetInfo(ghDbc, SQL_ODBC_SQL_CONFORMANCE, ri, cbInfoValueMax, pcbInfoValue)
If result <> SQL_ERROR Then
Select Case ri
Case SQL_OSC_MINIMUM
temp = "Minimum Grammar"
Case SQL_OSC_CORE
temp = "Core Grammar"
Case SQL_OSC_EXTENDED
temp = "Extended Grammar"
End Select
grdGI.AddItem "SQL Grammar Level " & Chr$(9) & temp
End If
If grdGI.Rows > 2 Then
grdGI.RemoveItem 1
End If
End Sub